home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: Alpha / Whiteline Alpha.iso / tex / strunk / disk_3 / laser.lzh / bin / dvi_ps.ps < prev    next >
Encoding:
Text File  |  1990-11-11  |  12.1 KB  |  402 lines
  1. % This is DVI_PS.PS version 0.60
  2. %
  3. % The following defines procedures assumed and used by program "dvi_ps".
  4. % Originated by Neal Holtz, Carleton University, Ottawa, Canada
  5. %      <holtz@cascade.carleton.cdn>
  6. %      June, 1985
  7. %
  8. %   Hacked by tgr, July 1987, stripped down to bare essentials,
  9. %   plus a few new commands for speed.
  10. %
  11. %   Hacked by don, December 1989, to give characters top down and to
  12. %   remove other small nuisances; merged with tgr's compression scheme
  13. %
  14. %   Hacked by cs, September 1990, to adapt to dvi_ps conventions
  15. %
  16. %   Hacked by cs, November 1990, to add EPSF includes
  17. %
  18. %   To observe available VM, uncomment the following.
  19. %   (The first ten lines define a general 'printnumber' routine.)
  20. %
  21. % /VirginMtrx 6 array currentmatrix def
  22. % /dummystring 20 string def
  23. % /numberpos 36 def
  24. % /printnumber { gsave VirginMtrx setmatrix
  25. %   /Helvetica findfont 10 scalefont setfont
  26. %   36 numberpos moveto
  27. %   /numberpos numberpos 12 add def
  28. %   dummystring cvs show
  29. %   grestore
  30. %   } bind def
  31. % /showVM { vmstatus exch sub exch pop printnumber } def
  32. % /eop-aux { showVM } def
  33. %
  34.  
  35. /TeXDict 200 dict def   % define a working dictionary
  36. TeXDict begin           % start using it.
  37.  
  38. /bdf { bind def } def
  39.  
  40. % The output of dvi_ps assumes pixel units, Resolution/inch, with
  41. % increasing y coordinates corresponding to moving DOWNWARD.
  42. % The PostScript default is big point units (bp), 72/inch, with
  43. % increasing y coordinates corresponding to moving UP; the
  44. % following routines handle conversion to dvi_ps conventions. 
  45.  
  46. % Let the PostScript origin be (xps,yps) in dvi_ps coordinates.
  47. /@rigin                 % -xps -yps @rigin -   establishes dvi_ps conventions
  48.   { 72 Resolution div 72 VResolution div neg scale
  49.     translate
  50.   } bdf
  51.  
  52. % Here we assume the PostScript origin is at the bottom left corner
  53. % and that the paper is 11 inches high;
  54. % the dvi_ps origin is 1 inch from top left corner;
  55. % hence if Resolution=300, we have (xps,yps)=(-300,3000). 
  56. /@letter                % setup for standard letter format
  57.   { Resolution VResolution -10 mul @rigin } bdf
  58.  
  59. /@landscape
  60.   { [ 0 1 -1 0 0 0 ] concat
  61.     Resolution VResolution @rigin } bdf
  62.  
  63. /@a4
  64.   { Resolution VResolution -10.6929133858 mul @rigin } bdf
  65.  
  66. /@legal
  67.   { Resolution VResolution -13 mul @rigin } bdf
  68.  
  69. /@manualfeed
  70.    { statusdict /manualfeed true put
  71.    } bdf
  72.  
  73.         % n @copies -   set number of copies
  74. /@copies
  75.    { /#copies exch def
  76.    } bdf
  77.  
  78. % Bitmap fonts are called fa, fb, ..., fz, f0, f1, ...; the maximum
  79. % supported by these macros is f999, but if you really go up that high
  80. % you need to increase the size of TeXDict.
  81. % The calling sequence for downloading font foo is
  82. %           /foo df chardef1 ... chardefn dfe
  83. % where each chardef is
  84. %           [<hexstring> wd ht xoff yoff dx] charno dc
  85.  
  86. /@FontMatrix [1 0 0 -1 0 0] def
  87. /@FontBBox [0 0 0 0] def
  88. % alternative: /@FontBBox [0 0 1 1] def
  89.  
  90. /@newfont  % id @newfont -         -- initialize a new font dictionary
  91.   { /newname exch def
  92.     pop
  93.     newname 7 dict def              % allocate new font dictionary
  94.     newname load begin
  95.         /FontType 3 def
  96.     /FontMatrix @FontMatrix def
  97.     /FontBBox @FontBBox def
  98.         /BitMaps 256 array def
  99.         /BuildChar {CharBuilder} def
  100.         /Encoding IdentityEncoding def
  101.         end
  102. %    newname newname load definefont pop
  103.     newname dup load definefont setfont
  104.   } bdf
  105.  
  106. % the following is the only character builder we need.  it looks up the
  107. % char data in the BitMaps array, and paints the character if possible.
  108. % char data  -- a bitmap descriptor -- is an array of length 6, of
  109. %          which the various slots are:
  110.  
  111. /ch-image {ch-data 0 get} bdf   % the hex string image
  112. /ch-width {ch-data 1 get} bdf   % the number of pixels across
  113. /ch-height {ch-data 2 get} bdf  % the number of pixels tall
  114. /ch-xoff  {ch-data 3 get} bdf   % number of pixels to right of origin
  115. /ch-yoff  {ch-data 4 get} bdf   % number of pixels below origin
  116. /ch-dx  {ch-data 5 get} bdf     % number of pixels to next character
  117.  
  118. /CharBuilder    % fontdict ch Charbuilder -     -- image one character
  119.      {save 3 1 roll exch /BitMaps get exch get /ch-data exch def
  120.       ch-data null ne
  121.       {ch-dx 0 ch-xoff ch-yoff neg
  122.        ch-xoff ch-width add ch-height ch-yoff sub
  123.        setcachedevice
  124.        ch-width ch-height true
  125.        [1 0 0 -1 -.1 ch-xoff sub ch-height ch-yoff sub .1 add]
  126. % begin code for uncompressed fonts only
  127.        {ch-image} imagemask
  128.      }if
  129.      restore
  130.   } bdf
  131. % end code for uncompressed fonts only
  132. % % here's the alternate code for unpacking compressed fonts
  133. %      /id ch-image def                          % image data
  134. %      /rw ch-width 7 add 8 idiv string def      % row, initially zero
  135. %      /rc 0 def                                 % repeat count
  136. %      /gp 0 def                                 % image data pointer
  137. %      /cp 0 def                                 % column pointer
  138. %      { rc 0 ne { rc 1 sub /rc exch def rw } { G } ifelse } imagemask
  139. %    }if
  140. %    restore
  141. % } bdf
  142. % /G { { id gp get /gp gp 1 add def
  143. %   dup 18 mod exch 18 idiv pl exch get exec } loop } bdf
  144. % /adv { cp add /cp exch def } bdf
  145. % /chg { rw cp id gp 4 index getinterval putinterval
  146. %         dup gp add /gp exch def adv } bdf
  147. % /nd { /cp 0 def rw exit } bdf
  148. % /lsh { rw cp 2 copy get dup 0 eq { pop 1 } { dup 255 eq { pop 254 }
  149. %     { dup dup add 255 and exch 1 and or } ifelse } ifelse put 1 adv } bdf
  150. % /rsh { rw cp 2 copy get dup 0 eq { pop 128 } { dup 255 eq { pop 127 }
  151. %     { dup 2 idiv exch 128 and or } ifelse } ifelse put 1 adv } bdf
  152. % /clr { rw cp 2 index string putinterval adv } bdf
  153. % /set { rw cp fillstr 0 4 index getinterval putinterval adv } bdf
  154. % /fillstr 18 string 0 1 17 { 2 copy 255 put pop } for def
  155. % /pl [
  156. %    { adv 1 chg } bind
  157. %    { adv 1 chg nd } bind
  158. %    { 1 add chg } bind
  159. %    { 1 add chg nd } bind
  160. %    { adv lsh } bind
  161. %    { adv lsh nd } bind
  162. %    { adv rsh } bind
  163. %    { adv rsh nd } bind
  164. %    { 1 add adv } bind
  165. %    { /rc exch def nd } bind
  166. %    { 1 add set } bind
  167. %    { 1 add clr } bind
  168. %    { adv 2 chg } bind
  169. %    { adv 2 chg nd } bind
  170. %    { pop nd } bind ] def
  171. % % end of code for unpacking compressed fonts
  172.  
  173. % fontdict @sf -        -- make that the current font
  174. /@sf
  175.   { setfont
  176.   } bdf
  177.  
  178. % in the following, the font-cacheing mechanism requires that
  179.  % a name unique in the particular font be generated
  180.  
  181. /@dc          % char-data ch dc -    -- define character bitmap in current font
  182.   { /ch-code exch def
  183.     /ch-data exch def
  184.     currentfont /BitMaps get ch-code ch-data put
  185. %    newname load /BitMaps get ch-code ch-data put
  186.   } bdf
  187.  
  188. /@bop0          % n @bop0 -    -- begin the char def section of a new page
  189.   { (Page ) print == flush
  190.   } def
  191.  
  192. /@bop1           % n @bop1 -              -- begin a brand new page
  193.   { pop
  194.     gsave /SaveImage save def
  195.     0 0 moveto
  196.   } bdf
  197.  
  198. /eop           % - eop -              -- end a page
  199.   { % eop-aux  % -- to observe VM usage
  200.     clear SaveImage restore
  201.     showpage grestore
  202.   } bdf
  203.  
  204. /@start         % - @start -            -- start everything
  205.   {
  206.     /VResolution exch def
  207.     /Resolution exch def
  208.     /IdentityEncoding 256 array def
  209.     0 1 255 {IdentityEncoding exch 1 string dup 0 3 index put cvn put} for
  210.   } bdf
  211.  
  212. /RuleMatrix [ 1 0 0 -1 -.1 -.1 ] def % things we need for rules
  213. /BlackDots 8 string def
  214. /v {                   % can't use ...fill; it makes rules too big
  215.    gsave
  216.       currentpoint translate
  217.       false RuleMatrix { BlackDots } imagemask
  218.    grestore
  219. } bdf
  220.  
  221.  
  222. /ru        % dx dy ru -   -- set a rule (rectangle)
  223.   { /dy exch def
  224.     /dx exch def
  225. % remember current point
  226.     /x currentpoint /y exch def def
  227.     newpath x y moveto
  228.     dx 0 rlineto
  229.     0 dy rlineto
  230.     dx neg 0 rlineto
  231.     closepath fill
  232.     x y moveto
  233.   } bdf
  234.  
  235. /p               % x y p -               -- move to position
  236.   { moveto
  237.   } bdf
  238.  
  239. /r               % x r -                 -- move right
  240.   { 0 rmoveto
  241.   } bdf
  242.  
  243.  
  244. /s               % string s -            -- show the string
  245.   { show
  246.   } bdf
  247.  
  248. /c               % ch c -                -- show the character (code given)
  249.   { c-string exch 0 exch put
  250.     c-string show
  251.   } bdf
  252.  
  253. /c-string ( ) def
  254.  
  255. %%%%%%%%%%%%%%%%%%%%% Lines for CS Graphics %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  256.  
  257. % dx dy @li -   -- draw a line (to be used with CS-Graphics)
  258. /@li
  259.   { /dy exch def
  260.     /dx exch def
  261.     /x currentpoint /y exch def def
  262.     newpath
  263.     x y moveto
  264.     dx dy rlineto
  265.     stroke
  266.     x y moveto
  267.   } bdf
  268.  
  269. %%%%%%%%%%%%%%%%%%% Bit Images for CS Graphics %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  270.  
  271. % image width height xscale yscale @img  -  draw a bit image
  272. /@img
  273.   {
  274.     /img-yscale exch def
  275.     /img-xscale exch def
  276.     /img-height exch def
  277.     /img-width exch def
  278.     /img-image exch def
  279.     gsave
  280.     currentpoint translate
  281.     img-width img-xscale mul img-height img-yscale mul scale
  282.     img-width img-height true
  283.     [img-width 0  0 img-height 0 img-height]
  284.         {img-image} imagemask
  285.     grestore
  286.     /img-image <00> def % free the memory again
  287.   } bdf
  288.  
  289. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  290. %%     header for the \special{psfile=...} command
  291. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  292. %   The structure of the PostScript produced by dvips for \special is:
  293. %         @beginspecial
  294. %           - any number of @hsize, @hoffset, @hscale, etc., commands
  295. %         @setspecial
  296. %           - the user's file of PostScript commands
  297. %         @endspecial
  298.  
  299. /SDict 200 dict def
  300. SDict begin
  301.  
  302. /@SpecialDefaults
  303.   { /hs 612 def
  304.     /vs 792 def
  305.     /ho 0 def
  306.     /vo 0 def
  307.     /hsc 1 def
  308.     /vsc 1 def
  309.     /ang 0 def
  310.     /CLIP false def
  311.     /BBcalc false def
  312.   } bdf
  313.  
  314. %
  315. %   The following definition sets up the units that hscale/vscale are in.
  316. %   For certain sites this might require change, but it is
  317. %   recommended instead that any macro packages that require
  318. %   hscale/vscale set the units appropriately via
  319. %
  320. %   \special{! /@scaleunit 1 def }
  321. %
  322. %   if global, or
  323. %
  324. %   \special{" /@scaleunit 1 def }
  325. %
  326. %   before each instance if multiple macro packages with
  327. %   different requirements are being used.
  328. %
  329. /@scaleunit 100 def
  330. %       s @hscale  -    set scale factor
  331. /@hscale {@scaleunit div /hsc exch def} bdf
  332. /@vscale {@scaleunit div /vsc exch def} bdf
  333.  
  334. %       d @hsize   -    specify a horizontal clipping dimension
  335. /@hsize {/hs exch def /CLIP true def} bdf
  336. /@vsize {/vs exch def /CLIP true def} bdf
  337.  
  338. %       d @hoffset -    specify a shift for the figure
  339. /@hoffset {/ho exch def} bdf
  340. /@voffset {/vo exch def} bdf
  341.  
  342. %       a @angle   -    set rotation angle
  343. /@angle {/ang exch def} bdf
  344.  
  345. %
  346. %   Here we handle bounding box calculations, if necessary.
  347. %
  348. /@rwi { 10 div /rwi exch def } bdf % rwi will be real width after scaling
  349. /@llx { /llx exch def } bdf
  350. /@lly { /lly exch def } bdf
  351. /@urx { /urx exch def } bdf
  352. /@ury { /ury exch def /BBcalc true def } bdf
  353.  
  354. end % of SDict
  355.  
  356. % this will be invoked as the result of a \special command (for the
  357. % inclusion of PostScript graphics).  The basic idea is to change all
  358. % scaling and graphics back to defaults, but to shift the origin
  359. % to the current position on the page.
  360.  
  361. /@beginspecial          % - @beginspecial -     -- enter special mode
  362.   { SDict begin
  363.     /SpecialSave save def
  364.     gsave
  365.     Resolution 72 div dup neg scale
  366.     currentpoint translate    %set the current point as the user's origin
  367.     @SpecialDefaults    % setup default offsets, scales, sizes, and angle
  368.   } bdf
  369.  
  370. /@setspecial    % to setup user specified offsets, scales, sizes (for clipping)
  371.   {
  372.     CLIP
  373.       { newpath 0 0 moveto hs 0 rlineto 0 vs rlineto hs neg 0 rlineto 
  374.         closepath clip }
  375.       { initclip }
  376.     ifelse
  377.     ho vo translate
  378.     hsc vsc scale
  379.     ang rotate
  380.     BBcalc
  381.       { rwi urx llx sub div dup scale
  382.         llx neg lly neg translate }
  383.     if
  384.     /showpage {} def
  385.     newpath
  386.   } bdf
  387.  
  388. /@endspecial            % - @endspecial -       -- leave special mode
  389.   { grestore clear SpecialSave restore
  390.     end
  391.   } bdf
  392. /@defspecial
  393.   {
  394.     SDict begin
  395.   } bdf
  396. /@fedspecial
  397.   {
  398.     end
  399.   } bdf
  400.  
  401. end  % revert to previous dictionary
  402.